;; https://debbugs.gnu.org/cgi/bugreport.cgi?bug=52835
;; redirect sdterr to stdout workaround used by GNU Guix:
;; https://git.savannah.gnu.org/cgit/guix.git/tree/gnu/installer/utils.scm?id=c0bc08d82c73e464a419f213d5ae5545bc67e2bf#n87

;; Test scenario for showing the bug from
;; https://debbugs.gnu.org/cgi/bugreport.cgi?bug=52835:

(call-with-output-file "/tmp/test.log"
  (λ (port)
    ;; Write both, output and errors to the file output
    ;; port.
    (with-output-to-port port
      (λ ()
        (with-error-to-port port
          (λ ()
            ;; echo "bong" to stderr, which is set to the
            ;; port, which writes to the output file at
            ;; "/tmp/test.log". Afterwards the file at
            ;; "/tmp/test.log" should contain "bong".
            (system* "bash" "-c" "echo bong >&2")))))))

;; Now lets see what is in the file:

(define* (get-string-from-file filename #:key (encoding "UTF-8"))
  (call-with-input-file filename
    (λ (port)
      (set-port-encoding! port encoding)
      (get-string-all port))))

(display
 (simple-format
  #f "~a\n"
  (get-string-from-file "/tmp/test.log")))

;; The file is empty! Something with (system* ...) does not
;; seem to handle stdout redirection to stderr correctly.

;; Also from the bug report another test case:

(with-error-to-port (current-output-port)
  (lambda ()
    ;; $$ in GNU Bash is the process id.
    (system* "bash" "-c" "echo $$; sleep 10")))

;; "you can actually inspect `/proc/<PID>/fd/` and see that
;; the stderr fd, 2, is actually closed. This means that the
;; next opened fd will take its place, to which writes to
;; stderr may end up."
;; -- https://debbugs.gnu.org/cgi/bugreport.cgi?bug=52835


;; There is a workaround for the bug, used in GNU Guix
;; source code at
;; https://git.savannah.gnu.org/cgit/guix.git/tree/gnu/installer/utils.scm?id=c0bc08d82c73e464a419f213d5ae5545bc67e2bf#n87
;; posted by dev@jpoiret.xyz on the Guile user mailing list:

(match-let (((input . output) (pipe)))
  ;; Hack to work around Guile bug 52835 -- How does
  ;; duplicating the port help? From the docs: "Returns a
  ;; new port which is opened on a duplicate of the file
  ;; descriptor underlying port, with mode string modes as
  ;; for open-file. The two ports will share a file position
  ;; and file status flags. [...]"
  (define dup-output (duplicate-port output "w"))
  ;; Void pipe, but holds the pid for close-pipe.
  (define dummy-pipe
    ;; Set current-input-port to /dev/null. -- What will be
    ;; read from there? Nothing?
    (with-input-from-file "/dev/null"
      (lambda ()
        ;; Set the current-output-port to the one created
        ;; above using (pipe).
        (with-output-to-port output
          (lambda ()
            ;; Set the error port to the duplicated output
            ;; port. This might be the redirection of stderr
            ;; to stdout.
            (with-error-to-port dup-output
              (lambda ()
                ;; Run open-file*, but why is there an empty
                ;; string prepended to command? Perhaps to
                ;; allow using either a list or a string as
                ;; a command?
                (apply open-pipe* (cons "" command)))))))))

  (close-port output)
  (close-port dup-output)
  (handler input)
  (close-port input)
  (close-pipe dummy-pipe))
